home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / comint / telnet.el.z / telnet.el
Encoding:
Text File  |  1998-05-21  |  12.5 KB  |  329 lines
  1. ;;; telnet.el --- run a telnet session from within an Emacs buffer
  2.  
  3. ;;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: William F. Schelter
  6. ;; Keywords: comm, unix
  7. ;; Maintainer: FSF
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.34.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; This mode is intended to be used for telnet or rsh to a remode host;
  31. ;; `telnet' and `rsh' are the two entry points.  Multiple telnet or rsh
  32. ;; sessions are supported.
  33. ;;
  34. ;; Normally, input is sent to the remote telnet/rsh line-by-line, as you
  35. ;; type RET or LFD.  C-c C-c sends a C-c to the remote immediately; 
  36. ;; C-c C-z sends C-z immediately.  C-c C-q followed by any character
  37. ;; sends that character immediately.
  38. ;;
  39. ;; All RET characters are filtered out of the output coming back from the
  40. ;; remote system.  The mode tries to do other useful translations based
  41. ;; on what it sees coming back from the other system before the password
  42. ;; query.  It knows about UNIX, ITS, TOPS-20 and Explorer systems.
  43.  
  44. ;;; Code:
  45.  
  46. ;; to do fix software types for lispm:
  47. ;; to eval current expression.  Also to try to send escape keys correctly.
  48. ;; essentially we'll want the rubout-handler off.
  49.  
  50. ;; filter is simplistic but should be okay for typical shell usage.
  51. ;; needs hacking if it is going to deal with asynchronous output in a sane
  52. ;; manner
  53.  
  54. (require 'comint)
  55.  
  56. (defgroup telnet nil
  57.   "Run a telnet session from within an Emacs buffer."
  58.   :group 'comint)
  59.  
  60. (defvar telnet-new-line "\r")
  61. (defvar telnet-mode-map nil)
  62. (defvar telnet-default-prompt-pattern "^[^#$%>\n]*[#$%>] *")
  63. (defvar telnet-prompt-pattern telnet-default-prompt-pattern)
  64.  
  65. (defvar telnet-replace-c-g nil)
  66. (make-variable-buffer-local
  67.  (defvar telnet-remote-echoes t
  68.    "True if the telnet process will echo input."))
  69. (make-variable-buffer-local
  70.  (defvar telnet-interrupt-string "\C-c" "String sent by C-c."))
  71.  
  72. (defvar telnet-count 0
  73.   "Number of output strings read from the telnet process
  74. while looking for the initial password.")
  75. ;; (make-variable-buffer-local 'telnet-count)
  76.  
  77. (defcustom telnet-program "telnet"
  78.   "*Program to run to open a telnet connection."
  79.   :type 'string
  80.   :group 'telnet)
  81.  
  82. (defcustom rsh-eat-password-string nil
  83.   "Non-nil means rsh will look for a string matching a password prompt."
  84.   :type 'boolean
  85.   :group 'telnet)
  86.  
  87. (defvar telnet-initial-count -75
  88.   "Initial value of `telnet-count'.  Should be set to the negative of the
  89. number of terminal writes telnet will make setting up the host connection.")
  90.  
  91. (defvar telnet-maximum-count 4
  92.   "Maximum value `telnet-count' can have.
  93. After this many passes, we stop looking for initial setup data.
  94. Should be set to the number of terminal writes telnet will make
  95. rejecting one login and prompting again for a username and password.")
  96.  
  97. (defun telnet-interrupt-subjob ()
  98.   (interactive)
  99.   "Interrupt the program running through telnet on the remote host."
  100.   (process-send-string nil telnet-interrupt-string))
  101.  
  102. (defun telnet-c-z ()
  103.   (interactive)
  104.   (process-send-string nil "\C-z"))
  105.  
  106. ;; XEmacs change (Keep telnet- prefix)
  107. (defun telnet-send-process-next-char ()
  108.   (interactive)
  109.   (process-send-string nil
  110.            (char-to-string
  111.         (let ((inhibit-quit t))
  112.           (prog1 (read-char)
  113.             (setq quit-flag nil))))))
  114.  
  115. ; initialization on first load.
  116. (if telnet-mode-map
  117.     nil
  118.   ;; FSF
  119.   ;; (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map))
  120.   (setq telnet-mode-map (make-sparse-keymap))
  121.   (set-keymap-parents telnet-mode-map (list comint-mode-map))
  122.   (define-key telnet-mode-map "\C-m" 'telnet-send-input)
  123. ;  (define-key telnet-mode-map "\C-j" 'telnet-send-input)
  124.   (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char)
  125.   (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 
  126.   (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
  127.  
  128. ;;maybe should have a flag for when have found type
  129. (defun telnet-check-software-type-initialize (string)
  130.   "Tries to put correct initializations in.  Needs work."
  131.   (let ((case-fold-search t))
  132.     (cond ((string-match "unix" string)
  133.        (setq telnet-prompt-pattern shell-prompt-pattern)
  134.        (setq telnet-new-line "\n"))
  135.       ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
  136.        (setq telnet-prompt-pattern  "[@>] *"))
  137.       ((string-match "its" string)
  138.        (setq telnet-prompt-pattern  "^[^*>\n]*[*>] *"))
  139.       ((string-match "explorer" string) ;;explorer telnet needs work
  140.        (setq telnet-replace-c-g ?\n))))
  141.   (setq comint-prompt-regexp telnet-prompt-pattern))
  142.  
  143. (defun telnet-initial-filter (proc string)
  144.   (let ((case-fold-search t))
  145.     ;For reading up to and including password; also will get machine type.
  146.     (cond ((string-match "No such host" string)
  147.        (kill-buffer (process-buffer proc))
  148.        (error "No such host."))
  149.       ((string-match "passw" string)
  150.        (telnet-filter proc string)
  151.        (let ((password (comint-read-noecho "Password: " t)))
  152.          (setq telnet-count 0)
  153.          (process-send-string proc (concat password telnet-new-line))))
  154.       (t (telnet-check-software-type-initialize string)
  155.          (telnet-filter proc string)
  156.          (cond ((> telnet-count telnet-maximum-count)
  157.             ;; (set-process-filter proc 'telnet-filter) Kludge
  158.             ;; for shell-fonts -- this is the only mode that
  159.             ;; actually changes what its process filter is at
  160.             ;; run time, which confuses shell-font.  So we
  161.             ;; special-case that here.
  162.             ;; #### Danger, knows an internal shell-font variable name.
  163.             (let ((old-filter (process-filter proc)))
  164.               (if (eq old-filter 'shell-font-process-filter)
  165.               (set (make-local-variable 'shell-font-process-filter)
  166.                    'telnet-filter)
  167.             (set-process-filter proc 'telnet-filter))))
  168.            (t (setq telnet-count (1+ telnet-count))))))))
  169.  
  170. ;; Identical to comint-simple-send, except that it sends telnet-new-line
  171. ;; instead of "\n".
  172. (defun telnet-simple-send (proc string)
  173.   (comint-send-string proc string)
  174.   (comint-send-string proc telnet-new-line))
  175.  
  176. (defun telnet-filter (proc string)
  177.   (save-excursion
  178.     (set-buffer (process-buffer proc))
  179.     (save-match-data
  180.      (let* ((last-insertion (marker-position (process-mark proc)))
  181.         (delta (- (point) last-insertion))
  182.         (ie (and comint-last-input-end
  183.              (marker-position comint-last-input-end)))
  184.         (w (get-buffer-window (current-buffer)))
  185.         (ws (and w (window-start w))))
  186.        (goto-char last-insertion)
  187.     ;; Insert STRING, omitting all C-m characters.
  188.        (insert-before-markers string)
  189.        (set-marker (process-mark proc) (point))
  190.        ;; the insert-before-markers may have screwed window-start
  191.        ;; and likely moved comint-last-input-end.  This is why the
  192.        ;; insertion-reaction should be a property of markers, not
  193.        ;; of the function which does the inserting.
  194.        (if ws (set-window-start w ws t))
  195.        (if ie (set-marker comint-last-input-end ie))
  196.        (while (progn (skip-chars-backward "^\C-m" last-insertion)
  197.              (> (point) last-insertion))
  198.      (delete-region (1- (point)) (point)))
  199.        (goto-char (process-mark proc))
  200.        (and telnet-replace-c-g
  201.         (subst-char-in-region last-insertion (point) ?\C-g
  202.                   telnet-replace-c-g t))
  203.       ;; If point is after the insertion place, move it
  204.       ;; along with the text.
  205.       (if (> delta 0)
  206.       (goto-char (+ (process-mark proc) delta)))))))
  207.  
  208. (defun telnet-send-input ()
  209.   (interactive)
  210.   (let ((proc (get-buffer-process (current-buffer)))
  211.     p1 p2)
  212.     (if (and telnet-remote-echoes
  213.          (>= (point) (process-mark proc)))
  214.     (save-excursion
  215.       (if comint-eol-on-send (end-of-line))
  216.       (setq p1 (marker-position (process-mark proc))
  217.         p2 (point))))
  218.     (prog1
  219.     (comint-send-input)
  220.       ;; at this point, comint-send-input has moved the process mark, inserted
  221.       ;; a newline, and possibly inserted the (echoed) output.  If the host is
  222.       ;; in remote-echo mode, then delete our local copy of the command, and
  223.       ;; the newline that comint-send-input sent.
  224.       (if p1
  225.       (delete-region p1 (1+ p2))))))
  226.  
  227. ;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
  228.  
  229. ;;;###autoload
  230. (defun telnet (host &optional port)
  231.   "Open a network login connection to host named HOST (a string).
  232. With a prefix argument, prompts for the port name or number as well.
  233. Communication with HOST is recorded in a buffer `*HOST-telnet*'.
  234. Normally input is edited in Emacs and sent a line at a time.
  235. See also `\\[rsh]'."
  236.   (interactive (list (read-string "Open telnet connection to host: ")
  237.              (if current-prefix-arg
  238.              (read-string "Port name or number: ")
  239.                nil)))
  240.   (let* ((comint-delimiter-argument-list '(?\  ?\t))
  241.          (name (concat "telnet-" (comint-arguments host 0 nil)
  242.                (if port (concat "/" port) "")))
  243.          (buffer (get-buffer (concat "*" name "*")))
  244.      process)
  245.     (if (and buffer (get-buffer-process buffer))
  246.     (pop-to-buffer buffer)
  247.       (pop-to-buffer (make-comint name telnet-program))
  248.       (setq process (get-buffer-process (current-buffer)))
  249.       (set-process-filter process 'telnet-initial-filter)
  250.       
  251.       ;; SunOS and IRIX don't print "unix" in their rsh or telnet
  252.       ;; login banners, so let's get a reasonable default here.
  253.       ;; #### This patch from jwz mimics what is done in rsh done
  254.       ;; below.  However, it (along with the one in rsh) mean that
  255.       ;; telnet-check-software-type-initialize is effectively a
  256.       ;; wastoid function.  Reworking it like it claims to need is
  257.       ;; probably the better solution but I'm not going to do it.
  258.       ;; --cet
  259.       (telnet-check-software-type-initialize "unix")
  260.       
  261.       ;; Don't send the `open' cmd till telnet is ready for it.
  262.       (accept-process-output process)
  263.       (erase-buffer)
  264.       (process-send-string process (concat "open " host
  265.                        (if port (concat " " port) "")
  266.                        "\n"))
  267.       (setq comint-input-sender 'telnet-simple-send)
  268.       ;; run last so that hooks can change things.
  269.       (telnet-mode))))
  270.  
  271. (defun telnet-mode ()
  272.   "This mode is for using telnet (or rsh) from a buffer to another host.
  273. It has most of the same commands as comint-mode.
  274. There is a variable ``telnet-interrupt-string'' which is the character
  275. sent to try to stop execution of a job on the remote host.
  276. Data is sent to the remote host when RET is typed.
  277.  
  278. \\{telnet-mode-map}
  279. "
  280.   (interactive)
  281.   (comint-mode)
  282.   (setq major-mode 'telnet-mode
  283.         mode-name "Telnet"
  284.         comint-prompt-regexp telnet-prompt-pattern)
  285.   (use-local-map telnet-mode-map)
  286.   (set (make-local-variable 'telnet-count) telnet-initial-count)
  287.   (run-hooks 'telnet-mode-hook))
  288.  
  289. ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
  290.  
  291. ;; Berkeley spawn of hell
  292. ;;;###autoload
  293. (defun rsh (host)
  294.   "Open a network login connection to host named HOST (a string).
  295. Communication with HOST is recorded in a buffer `*rsh-HOST*'.
  296. Normally input is edited in Emacs and sent a line at a time.
  297. See also `\\[telnet]'."
  298.   (interactive "sOpen rsh connection to host: ")
  299.   (require 'shell)
  300.   (let ((name (concat "rsh-" host)))
  301.     (pop-to-buffer (make-comint name remote-shell-program nil host))
  302.     (set (make-local-variable 'telnet-count) telnet-initial-count)
  303.     ;;
  304.     ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a
  305.     ;; reasonable default here.  There do exist non-Unix machines which
  306.     ;; speak the rsh protocol, but let's hope they print their OS name
  307.     ;; when one connects.
  308.     ;;
  309.     (telnet-check-software-type-initialize "unix")
  310.     ;;
  311.     ;; I think we should use telnet-filter here instead of -initial-filter,
  312.     ;; because rsh generally doesn't prompt for a password, and gobbling the
  313.     ;; first line that contains "passw" is extremely antisocial.  More
  314.     ;; antisocial than echoing a password, and more likely than connecting
  315.     ;; to a non-Unix rsh host these days...
  316.     ;;
  317.     ;; I disagree with the above.  -sb
  318.     ;;
  319.     (set-process-filter (get-process name) (if rsh-eat-password-string
  320.                            'telnet-initial-filter
  321.                          'telnet-filter))
  322.     ;; (set-process-filter (get-process name) 'telnet-filter)
  323.     ;; run last so that hooks can change things.
  324.     (telnet-mode)))
  325.  
  326. (provide 'telnet)
  327.  
  328. ;;; telnet.el ends here
  329.